#!./perl
$/=";";
#open(F,"cat ../def/defrReader.hpp ../def/defwWriterCalls.hpp|");
$lang="python";
if($ARGV[0] =~ /^-perl/o){
   $lang="perl5";
   shift @ARGV;
}elsif($ARGV[0] =~ /^-tcl/o){
   $lang="tcl8";
   shift @ARGV;
}elsif($ARGV[0] =~ /^-py/o){
   $lang="python";
   shift @ARGV;
}
while(<>){
   s|/*.*?\*/||go;
   if(/typedef\s+(\w+)\s+\(\*(\w+FnType)\s*\)/o){
      $t=$2; $ret=$1;
      s/\n//og;
      s/PROTO_PARAMS\(//o;
      s/\)\)/)/o;
      $_ =~ /(\([^\)]+\))\s*;/o;
      $args=$1; $args =~ s/\s+/ /go;
      $proto{$t}=[$ret,$args];
#      print "#$ret $t $args\n";
   }elsif(/EXTERN\s+void\s+(\w+)\s*\(\s*(\w+)\s*\)/o){
      $set=$1; $t=$2;
      $args=$proto{$t}[1];
      $args =~ s/(def[rw]CallbackType)_e/$1_e cbkType/o;
      $rw=$1;
      $args =~ s/defiUserData/defiUserData userData/o;

      $tran2="";
      if($args =~ s/,\s*(\w+\W*\w*\s*\*)\s*\w*\s*,/,$1 _arg2,/o){
         $a2type=$1;
         $a2type=~ s/\*//o;
         $a2type =~ s/\s+$//o;
         if($a2type =~ /\bchar\b/o){
            $tran2="strcpy(arg2_str,arg2);";
         }else{
            $tran2="SWIG_MakePtr(arg2_str, (void *)arg2,\"_${a2type}_p\");";
         }
      }elsif($args =~ s/,\s*(int\W+)\w+\s*,/,$1 _arg2,/o){
         $a2type=$1;
         $tran2="sprintf(arg2_str,\"%d\",arg2);";
      }elsif($args =~ s/,\s*(double\W+)\w+\s*,/,$1 _arg2,/o){
         $a2type=$1;
         $tran2="sprintf(arg2_str,\"%g\",arg2);";
      }

      ##  $set =~ s/Cbk//o;
      open(F,">./cbk.i0"); 
      print F <<"END";
%module t
#define defiUserData void *
#if defined(SWIGPYTHON)
%typemap(out) PyObject *{
   \$result=(PyObject *)\$1;
}
%typemap(out) void *{
   if(\$1==NULL){
      Py_INCREF(Py_None);
      \$result=Py_None;
   }else{ 
      \$result=(PyObject *)\$1;
   }
}
#elif defined(SWIGPERL)
%typemap(out) SV *{
   \$result=(SV *)\$1;
}
%typemap(out) void *{
   \$result=(SV *)\$1;
}
#elif defined(SWIGTCL)
%typemap(out) void *{
   if(\$1)
      \$result=(Tcl_Obj *)\$1;
   else
      \$result=Tcl_NewStringObj("",-1);
}
#endif
%include "classPtr.i"

typedef enum{
}defwCallbackType_e;

typedef enum {
}defrCallbackType_e;
$proto{$t}[0] (*$set)$args;
END
      close(F);
      print STDERR "Translating $set ...\n";
      open(FF,"perl mkcallback.pl -$lang cbk.i0|");
      while(<FF>){
         if(/defrCallbackType_e;$/o){last;}
      }
      while(<FF>){
         print;
    #     print STDERR $_;
      }
      close(FF);
   }
}

